home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / dev / e / ProcIdx.lha / ProcIdx / ProcIdx.e < prev    next >
Text File  |  1996-03-05  |  2KB  |  76 lines
  1. /*  Procedure Index v1.0
  2.      2/5/96  J. Tierney
  3.  
  4.   Usage: ProcIdx [FROM] <file> [TO <file>]
  5.     - Output defaults to the current CON:
  6. */
  7.  
  8. MODULE 'dos/dos',
  9.        'exec/libraries'
  10.  
  11. CONST MAXSTRLEN = 256
  12.  
  13. ENUM OK=0, ER_ARGS, ER_SRC, ER_DST,
  14.      RA_SRC=0, RA_DEST, RA_COUNT
  15.  
  16. RAISE ER_ARGS IF ReadArgs() = NIL
  17.  
  18. PROC main() HANDLE
  19.   DEF rc=RETURN_OK, rdargs=NIL, opts:PTR TO LONG,
  20.       dest, fhs=NIL, fhd=NIL, dlib:PTR TO lib,
  21.       fbuf[MAXSTRLEN]:ARRAY OF CHAR, fbuflen, outstr[80]:STRING,
  22.       linecnt=1, proccnt=0, l, so, eo
  23.  
  24.   NEW opts[RA_COUNT]
  25.   rdargs:=ReadArgs('FROM/A,TO/K', opts, NIL)
  26.   dest:=IF opts[RA_DEST] THEN opts[RA_DEST] ELSE 'CONSOLE:'
  27.  
  28.   fhs:=Open(opts[RA_SRC], MODE_OLDFILE)
  29.   IF fhs = NIL THEN Raise(ER_SRC)
  30.   fhd:=Open(dest, MODE_NEWFILE)
  31.   IF fhd = NIL THEN Raise(ER_DST)
  32.  
  33.   dlib:=dosbase
  34.   fbuflen:=IF dlib < 39 THEN MAXSTRLEN - 1 ELSE MAXSTRLEN
  35.  
  36.   WHILE Fgets(fhs, fbuf, fbuflen)
  37.     l:=StrLen(fbuf)
  38.     IF l > 7
  39.       FOR so:=0 TO l DO EXIT fbuf[so] <> 32
  40.       IF StrCmp(fbuf + so, 'PROC ', 5)
  41.         eo:=InStr(fbuf, '(')
  42.         StrCopy(outstr, fbuf + so + 5, eo - so - 5)
  43.         StringF(outstr, '\l\s[30]\r\d[4]\n', outstr, linecnt)
  44.         IF Fputs(fhd, outstr) THEN Raise(ER_DST)
  45.         INC proccnt
  46.       ENDIF
  47.     ENDIF
  48.     INC linecnt
  49.   ENDWHILE
  50.  
  51.   StringF(outstr, '\nProcedures:  \d\n', proccnt)
  52.   IF Fputs(fhd, outstr) THEN Raise(ER_DST)
  53.  
  54.   EXCEPT DO
  55.     IF fhd THEN Close(fhd)
  56.     IF fhs THEN Close(fhs)
  57.     IF rdargs THEN FreeArgs(rdargs)
  58.     IF exception
  59.       SELECT exception
  60.         CASE ER_ARGS
  61.           so:='- Bad Args.'
  62.         CASE ER_SRC
  63.           so:='opening/reading source file.'
  64.         CASE ER_DST
  65.           so:='opening/writing destination file.'
  66.         CASE "MEM"
  67.           so:='allocating memory.'
  68.       ENDSELECT
  69.       WriteF('Error \s\n', so)
  70.       rc:=RETURN_ERROR
  71.     ENDIF
  72. ENDPROC rc
  73.  
  74. CHAR '$VER: ProcIdx 1.0 (5.2.96) by J. Tierney', 0
  75.  
  76.